home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / runtime / meta.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-24  |  2.1 KB  |  98 lines  |  [TEXT/MPS ]
  1. /* Primitives for the toplevel */
  2.  
  3. #include "alloc.h"
  4. #include "globals.h"
  5. #include "major_gc.h"
  6. #include "memory.h"
  7. #include "minor_gc.h"
  8. #include "mlvalues.h"
  9. #include "prims.h"
  10.  
  11. extern value interprete();
  12.  
  13. value start_interp(prog, offset, len) /* ML */
  14.      value prog, offset, len;
  15. {
  16. #if defined(BIG_ENDIAN) && !defined(ALIGNMENT)
  17.   fixup_endianness(&Byte(prog, 0), (asize_t) Long_val(len));
  18. #endif
  19.   return interprete(&Byte(prog, Long_val(offset)));
  20. }
  21.  
  22. value realloc_global(size)      /* ML */
  23.      value size;
  24. {
  25.   mlsize_t requested_size, actual_size, i;
  26.   value new_global_data;
  27.  
  28.   requested_size = Long_val(size);
  29.   actual_size = Wosize_val(global_data);
  30.   if (requested_size >= actual_size) {
  31.     requested_size = (requested_size + 0x100) & 0xFFFFFF00;
  32.     new_global_data = alloc_shr(requested_size, 0);
  33.     for (i = 0; i < actual_size; i++)
  34.       initialize(&Field(new_global_data, i), Field(global_data, i));
  35.     for (i = actual_size; i < requested_size; i++){
  36.       Field (new_global_data, i) = Val_long (0);
  37.     }
  38.     modify(&Field(new_global_data, GLOBAL_DATA), new_global_data);
  39.     global_data = new_global_data;
  40.   }
  41.   return Atom(0);
  42. }
  43.     
  44.     
  45. value static_alloc(size)        /* ML */
  46.      value size;
  47. {
  48.   return (value) stat_alloc((asize_t) Long_val(size));
  49. }
  50.  
  51. value static_free(blk)          /* ML */
  52.      value blk;
  53. {
  54.   stat_free((char *) blk);
  55.   return Atom(0);
  56. }
  57.  
  58. value static_resize(blk, new_size) /* ML */
  59.      value blk, new_size;
  60. {
  61.   return (value) stat_resize((char *) blk, (asize_t) Long_val(new_size));
  62. }
  63.  
  64. value gc(arg)                       /* ML */
  65.      value arg;
  66. {
  67.   minor_collection ();
  68.   return Val_long (major_collection ());
  69. }
  70.  
  71. value obj_is_block(arg)             /* ML */
  72.      value arg;
  73. {
  74.   return Atom(Is_block(arg));
  75. }
  76.  
  77. value obj_block(tag, size) /* ML */
  78.      value tag, size;
  79. {
  80.   value res;
  81.   mlsize_t sz, i;
  82.   tag_t tg;
  83.  
  84.   sz = Long_val(size);
  85.   tg = Long_val(tag);
  86.   if (sz == 0) return Atom(tg);
  87.   res = alloc(sz, tg);
  88.   for (i = 0; i < sz; i++)
  89.     Field(res, i) = Val_long(0);
  90.  
  91.   return res;
  92. }
  93.  
  94. value available_primitives()    /* ML */
  95. {
  96.   return copy_string_array(names_of_cprim);
  97. }
  98.